home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 08 - 1992 / 08.03 Jul 92 / Matrix Parser / Parser < prev    next >
Encoding:
Text File  |  1992-12-24  |  9.3 KB  |  226 lines  |  [TEXT/PJMM]

  1.  
  2. unit Parser;
  3.  
  4. interface
  5.  
  6.     uses
  7.         Globals;
  8.  
  9.     procedure parser (var ktot: longint; var ty: hdlstringarray0; var typ: hdlstringarray0; var typr: hdlintarray0; var nodetable: hdlarrayhdlnoderecord; var numnodes: longint; var error: str255);
  10.  
  11. implementation
  12.  
  13.  
  14.     procedure parser;
  15.  
  16.         label
  17.             992, 993;
  18.  
  19.         var
  20.             i, j, k, l, m, n, del, jtot: longint;
  21.             s1, s2, s3: boolean;
  22.  
  23.         procedure setnodefields (l, m, n: longint);
  24.  
  25.         begin
  26.             numnodes := numnodes + 1;
  27.             nodetable^^[numnodes] := hdlnoderecord(NewHandle(SizeOf(noderecord)));
  28.             nodetable^^[numnodes]^^.optype := typ^^[l]^^;                      {This procedure sets up the nodetable, }
  29.             nodetable^^[numnodes]^^.loptype := typ^^[m]^^;                   {using tokens in the expression to enter }
  30.             nodetable^^[numnodes]^^.roptype := typ^^[n]^^;                    {into the various fields.}
  31.             nodetable^^[numnodes]^^.op.index := ty^^[l]^^;
  32.             nodetable^^[numnodes]^^.lop.index := ty^^[m]^^;
  33.             nodetable^^[numnodes]^^.rop.index := ty^^[n]^^;
  34.         end;
  35.  
  36.         procedure reset (l, m, n: longint);
  37.             var
  38.                 k: longint;
  39.         begin                                                   {This procedure first collapses the total working number of tokens, jtot,}
  40.             jtot := jtot - n;                                  {by n. It then resets the ordered arrays, ty^^[k], typ^^[k]^^, and typr^^[k],}
  41.             for k := l to jtot do                           {to  ty^^[k+n]^^, typ^^[k+n]^^, and, typr^^[k+n], from,  k = l to jtot.}
  42.                 begin
  43.                     ty^^[k]^^ := ty^^[k + n]^^;
  44.                     typr^^[k] := typr^^[k + n];
  45.                     typ^^[k]^^ := typ^^[k + n]^^;
  46.                 end;
  47.         end;
  48.  
  49.         procedure setnodetoken (l: longint);
  50.         begin
  51.             ty^^[l]^^ := stringof(numnodes : 2);        {This procedure defines a node token, typ^^[l], sets its}
  52.             typ^^[l]^^ := 'node';                                {value equal to the number of the node in the table, and}
  53.             typr^^[l] := 0;                                        {its precedence value to 0.}
  54.         end;
  55.  
  56.  
  57.     begin
  58.  
  59.  
  60.         error := '';
  61.         jtot := ktot;                                          {Initialize 'error' to the null string and set jtot = ktot,}
  62.                                                                   {the number of tokens in the expression.}
  63.         numnodes := 0;                                      {Initialize number of nodes to zero.}
  64.         j := 0;
  65.         repeat
  66.             j := j + 1;
  67.             if j < 1 then
  68.                 j := 1;
  69.  
  70.  
  71.             if (j + 1) <= jtot then
  72.                 s1 := (typ^^[j + 1]^^ = 'constant') or (typ^^[j + 1]^^ = 'variable') or (typ^^[j + 1]^^ = 'matrix') or (typ^^[j + 1]^^ = 'node');
  73.             if (j - 1) >= 0 then
  74.                 s2 := (typ^^[j - 1]^^ = 'constant') or (typ^^[j - 1]^^ = 'variable') or (typ^^[j - 1]^^ = 'matrix') or (typ^^[j - 1]^^ = 'node');
  75.             if (j - 3) >= 0 then
  76.                 s3 := (typ^^[j - 3]^^ = 'constant') or (typ^^[j - 3]^^ = 'variable') or (typ^^[j - 3]^^ = 'matrix') or (typ^^[j - 3]^^ = 'node');
  77.  
  78.             if ((typ^^[j]^^ = 'unary') or (typ^^[j]^^ = 'function')) and s1 then
  79.                 begin
  80.                     setnodefields(j, j + 1, j + 1);        {If we encounter a unary or function token, we will create a new}
  81.                     setnodetoken(j);                            {node in the nodetable by entering the unary or function token in}
  82.                     reset(j + 1, jtot, 1);                     {the table,  along with its argument, then replace the unary or}
  83.                     j := j - 1;                                      {function token (in the ordered list), with a node token which has}
  84.                     goto 992;                                     {a value equal to the value of the node index. We then reorder the}
  85.                 end;                                                {the array of tokens, and reset j to j-1.}
  86.  
  87.             if (ty^^[j]^^ = quote) and s2 then
  88.                 begin                                              {If we encounter a quote and the token immediately to the left}
  89.                     setnodefields(j, j - 1, j - 1);         {is an operand token (variable,  constant, matrix, node), then}
  90.                     setnodetoken(j - 1);                       {we create a node in the nodetable. A node token is substituted }
  91.                     j := j - 1;                                      {in the position of the argument of the quote, i.e., just to the}
  92.                     reset(j + 1, jtot, 1);                     {left of the quote (in the ordered array), the quote token is then}
  93.                     j := j - 1;                                      {replaced by the next higher ordered token in the list. The quote}
  94.                     goto 992;                                     {quote and its argument are entered in the nodetable and the array}
  95.                 end;                                                 {of tokens is reduced by one.}
  96.  
  97.             if (typ^^[j]^^ = 'binary') and (ty^^[j]^^ <> '(') then       {If we encounter a binary token in the array which}
  98.                                                                                             {is not the left parenthesis, we will start to process.}
  99.  
  100.                 begin
  101.  
  102.              {     In the next bit of code, if we have a binary token two positions to the left of the jth token and the}
  103.              {priority of the (j-2)nd token is greater than or equal to the priority of the jth token we will go ahead}
  104.              {and process.}
  105.  
  106.  
  107.                     if (j - 2 >= 0) and (typ^^[j - 2]^^ <> 'binary') and (typ^^[j - 2]^^ <> 'unary') and (typ^^[j - 2]^^ <> 'function') then
  108.                         begin
  109.                             error := concat(ty^^[j - 2]^^, ' is not a binary token ');
  110.                             goto 993;
  111.                         end;
  112.  
  113.                     while (j - 2 >= 0) and (typr^^[j - 2] >= typr^^[j]) and (typ^^[j - 2]^^ <> 'unary') and (typ^^[j - 2]^^ <> 'function') do
  114.  
  115.                         begin
  116.  
  117.         {     The token between the two operator tokens (binary) and the token just to the left of the leftmost}
  118.         {binary token must both be operand tokens, otherwise an error.}
  119.  
  120.  
  121.                             if (not s2) and (not s3) then
  122.                                 begin
  123.                                     error := concat(ty^^[j - 3]^^, ' and ', ty^^[j - 1]^^, '  are not both operand tokens');
  124.                                     goto 993;
  125.                                 end;
  126.  
  127.                                                                          {We create a node in the nodetable, entering the binary operator }
  128.                             setnodefields(j - 2, j - 3, j - 1);     {token and the two operand tokens in the table, set the node token }
  129.                             setnodetoken(j - 3);                        {position in the ordered array to the position of the leftmost binary}
  130.                                                                          {token.}
  131.  
  132.  
  133.                             j := j - 3;                                        {Starting with the (j-2) nd position within the array, we}
  134.                             reset(j + 1, jtot, 2);                       {reorder the array, collapsing it by 2.}
  135.                             goto 992;
  136.  
  137.  
  138.                         end;
  139.  
  140.                     if ty^^[j]^^ = rightparen then
  141.                         begin
  142.  
  143.                             if (ty^^[j - 2]^^ <> leftparen) or (not s2) then
  144.                                 begin
  145.                                     error := ' ty^^[j-2]^^ <> leftparen token or ty^^[j-1] ^^<> an operand token';
  146.                                     error := concat(ty^^[j - 2]^^, ' is not a left parenthesis token or ', ty^^[j - 1]^^, '  is not an operand token');
  147.                                     goto 993;
  148.                                 end;
  149.  
  150.  
  151.                             if (jtot = 4) and (ty^^[j - 2]^^ = leftparen) and (ty^^[j]^^ = rightparen) then
  152.  
  153.                    {     If the token ty^^[j] ^^is a ")" and ty^^[j-2]^^is a "(", then we want to delete the}
  154.                    {parenentheses, and set up a unary node, since the operator has just one token}
  155.                    {following it. As an example, "-3".  The "3" has no parenthesis around it, but we}
  156.                    {still have to change its value from "3" to "-3". So, this necessitates a node point}
  157.                    {and an entry into the node table.}
  158.  
  159.                                 begin
  160.                                     numnodes := numnodes + 1;
  161.                                     nodetable^^[numnodes] := hdlnoderecord(NewHandle(SizeOf(noderecord)));
  162.                                     nodetable^^[numnodes]^^.optype := 'unary';
  163.                                     nodetable^^[numnodes]^^.loptype := typ^^[j - 1]^^;
  164.                                     nodetable^^[numnodes]^^.roptype := typ^^[j - 1]^^;
  165.                                     nodetable^^[numnodes]^^.op.index := plus;
  166.                                     nodetable^^[numnodes]^^.lop.index := ty^^[j - 1]^^;
  167.                                     nodetable^^[numnodes]^^.rop.index := ty^^[j - 1]^^;
  168.  
  169.                                     ty^^[j - 2]^^ := ty^^[j - 1]^^;
  170.                                     typr^^[j - 2] := typr^^[j - 1];
  171.                                     typ^^[j - 2]^^ := typ^^[j - 1]^^;
  172.  
  173.                                     j := j - 2;
  174.                                     reset(j + 1, jtot, 2);
  175.  
  176.                                     j := 2;
  177.                                     ty^^[j]^^ := semicolon;
  178.                                     goto 992;
  179.                                 end;
  180.  
  181.                             ty^^[j - 2]^^ := ty^^[j - 1]^^;
  182.                             typr^^[j - 2] := typr^^[j - 1];
  183.                             typ^^[j - 2]^^ := typ^^[j - 1]^^;
  184.  
  185.                             j := j - 2;
  186.                             reset(j + 1, jtot, 2);
  187.                             j := j - 2;
  188.  
  189.                             if j <= 0 then
  190.                                 j := 0;
  191.  
  192.                         end;
  193.  
  194. {     In the following, if jtot = 2 and j = 2, and the first token is an operand token, we create a unary}
  195. {node, then exit the program.}
  196.  
  197.                     if (jtot = 2) and (j = 2) then
  198.                         if (typ^^[j - 1]^^ = 'variable') or (typ^^[j - 1]^^ = 'constant') or (typ^^[j - 1]^^ = 'matrix') or (typ^^[j - 1]^^ = 'node') then
  199.                             begin
  200.                                 numnodes := numnodes + 1;
  201.                                 nodetable^^[numnodes] := hdlnoderecord(NewHandle(SizeOf(noderecord)));
  202.                                 nodetable^^[numnodes]^^.optype := 'unary';
  203.                                 nodetable^^[numnodes]^^.loptype := typ^^[j - 1]^^;
  204.                                 nodetable^^[numnodes]^^.roptype := typ^^[j - 1]^^;
  205.                                 nodetable^^[numnodes]^^.op.index := plus;
  206.                                 nodetable^^[numnodes]^^.lop.index := ty^^[j - 1]^^;
  207.                                 nodetable^^[numnodes]^^.rop.index := ty^^[j - 1]^^;
  208.                                 ty^^[j]^^ := semicolon;
  209.                             end;
  210.  
  211.  
  212. 992:
  213.                 end;
  214.  
  215.         until ty^^[j]^^ = semicolon;               {The process ends when we encounter a semicolon. However,}
  216.                                                             {j must be equal to 2.}
  217.  
  218.         if j <> 2 then
  219.             error := 'possible incorrect pairing of parentheses';
  220.  
  221. 993:
  222.         ktot := jtot;
  223.     end;
  224.  
  225.  
  226. end.